CU Amiga Super CD-ROM 17/CU Amiga Magazine's Super CD-ROM 17 (1997)(EMAP Images)(GB)[!][issue 1997-12].iso/CUCD/Online/News/Thor/HD-Install/thor25_arexx.lha/HeaderManager.thor

Text File | 1997-04-27 | 12KB | 380 lines

/* HeaderManager.thor - (c) Neil Bothwick 1996          */
/* $VER: HeaderManager.thor 1.15 (5.1.97)             */
/* Adds, edits and deletes header lines in Thor events  */

/* Thanks to ForwardMsg.thor by Petter Nilsen for some  */
/* of the user database code                            */

options results

/* ;;;needs THOR and bbsread.library functions */
thorport = address()
if left(thorport,5) ~= 'THOR.' then do
    say 'Headers.thor must be run from within Thor.'
    end

if ~show('p', 'BBSREAD') then do
    address command
    'run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead'
    'WaitForPort BBSREAD'
    end
;;;
/* ;;;Set up some stuff */
Changed = 0
drop Menu. HdrMenu.
Menu.1 = '""'
Menu.2 = '"Add new header"'
Menu.3 = '""'
Menu.4 = '"Save and exit"'
Menu.5 = '""'
Menu.6 = '"HELP"'
Menu.Count = 6
HdrMenu.1 = 'Cc:'
HdrMenu.2 = 'Bcc:'
HdrMenu.3 = 'Followup-To:'
HdrMenu.4 = 'Reply-To:'
HdrMenu.5 = 'Custom'
HdrMenu.Count = 5
ThorPath = pragma('D')
;;;
/* ;;;Read system details */
address(thorport)
drop GLOBALCFG. CURRENT. BBS.
GETGLOBALCONFIG stem GLOBALCFG
CURRENTSYSTEM stem CURRENT
System = CURRENT.BBSNAME

address(bbsread)
GETBBSDATA bbsname '"'System'"' stem BBS
MailAddr = BBS.EMAILADDR
DataPath = BBS.BBSPATH
;;;
/* ;;;Get number of selected event */
address(thorport)
GETSELECTEDEVENT
if(rc ~= 0) then do
    address(thorport)
    errstring = THOR.LASTERROR
    if RC = 5 then errstring = 'Event window not open'
    call ExitMsg(errstring)
    end
EventNo = result
;;;
/* ;;;Get event details */
address(bbsread)
READBREVENT '"'System'"' eventnr EventNo datastem EVENTDATA tagsstem EVENTTAGS
if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
if (EVENTDATA.EVENTTYPE > 1) & (EVENTDATA.EVENTTYPE ~= 9) then call ExitMsg('You can only edit the headers\nfor an Enter, Reply or Forward event')
MsgFile = DataPath||EVENTTAGS.MSGFILE
if pos('.',EVENTTAGS.CONFERENCE) > 0 then IsNews = 1
else IsNews = 0
;;;
/* ;;;Main loop */
call ReadHeaders
do until StopEdit = 1
    StopEdit = MainMenu()
    end

address(thorport)
if Changed = 1 then REQUESTNOTIFY '"You have changed some headers.\nDo you want to save them before exiting?"' '"_Yes|_No"'
if RC = 30 then call ExitMsg(THOR.LASTERROR)
if result = 1 then call WriteHeaders
;;;

exit

/* ;;;Show messages to user */
ShowMsg:
    OldAddr = address()
    address(thorport)
    parse arg MsgStr
    REQUESTNOTIFY '"'MsgStr'"' '" OK "'
    address(OldAddr)
    return
;;;
/* ;;;Exit with a message */
ExitMsg:
    parse arg errmsg
    call ShowMsg(errmsg)
    exit
;;;
/* ;;;Show main menu */
MainMenu:
    address(thorport)
    do i = 1 to Menu.Count
        interpret 'Header.'NowHeaders+i '=' Menu.i
        end
    Header.Count = NowHeaders + Menu.Count

    REQUESTLIST instem Header SIZEGADGET title '"Headers in current message"'
    if RC = 30 then call ExitMsg(THOR.LASTERROR)
    option = result
    if RC = 5 then return 1
    select
        when option = '' then nop
        when option = 'Add new header' then call AddHeader
        when option = 'Save and exit' then do
            call WriteHeaders
            return 1
            end
        when option = 'HELP' then do
            address command 'MultiView `GetEnv THOR/THORPath`docs/HeaderManager.guide PUBSCREEN' GLOBALCFG.PUBSCREENNAME
            end
        otherwise do
            /* Get number of header selected */
            HdrNo = 0
            do i = 1 to NowHeaders
                if Header.i = option then HdrNo = i
                end

            REQUESTNOTIFY '"'option'\n\nEdit or Delete this header?"' '"_Edit|_Delete"'
            if RC > 0 then ExitMsg(THOR.LASTERROR)
            if result = 1 then call EditHeader
            else call DeleteHeader
            end
        end
    return 0
;;;
/* ;;;Read headers in current event */
ReadHeaders:
    address(thorport)
    if ~open(msg,MsgFile,'R') then call ExitMsg('Failed to open message file')
    n = 0
    drop Header.
    Header.Count = 0
    do until eof(msg)
        NextLine = readln(msg)
        if length(NextLine)=0 | right(word(NextLine,1),1) ~= ':' then leave
        n = n + 1
        Header.n = NextLine
        Header.Count = n
        end
    call close(msg)
    MsgHeaders = Header.Count
    NowHeaders = Header.Count
    return
;;;
/* ;;;Update message file with new headers */
WriteHeaders:
    address(thorport)
    OutFile = 'T:ThorHeaders.'time(s)
    if ~open(msg,MsgFile,'R') then call ExitMsg('Failed to open message file')
    if ~open(out,OutFile,'W') then call ExitMsg('Failed to open temporary file')
    do i = 1 to MsgHeaders
        call readln(msg)
        end
    do i = 1 to NowHeaders
        call writeln(out,Header.i)
        end
    if MsgHeaders = 0 & NowHeaders > 0 then call writeln(out,'')
    do until eof(msg)
        block = readch(msg, 1048576)
        call writech(out,block)
        end
    call close(out)
    call close(msg)
    address command 'copy' OutFile MsgFile
    address command 'delete >NIL:' OutFile
    Changed = 0
    return
;;;
/* ;;;Add a new header */
AddHeader:
    REQUESTLIST instem HdrMenu SIZEGADGET title '"Choose header to add"'
    if RC = 30 then call ExitMsg(THOR.LASTERROR)
    if RC = 5 then return
    Hdr = result
    select
        when Hdr = 'Cc:' then do
            if IsNews = 0 then call GetAddress
            else do
                call ShowMsg('Cc: headers not allowed in news')
                Hdr = ''
                end
            end
        when Hdr = 'Bcc:' then do
            Hdr = 'bcc:'
            if IsNews = 0 then call GetAddress
            else do
                call ShowMsg('Bcc: headers not allowed in news')
                Hdr = ''
                end
            end
        when Hdr = 'Followup-To:' then do
            if IsNews = 1 then call GetConf
            else do
                call ShowMsg('Followup-To: headers not allowed in mail')
                Hdr = ''
                end
            end
        when Hdr = 'Reply-To:' then do
            call GetAddress
            end
        when Hdr = 'Custom' then do
            REQUESTSTRING title '"Add header"' body '"Enter custom header"' bt '" OK |Cancel"' id '"X-"'
            if RC = 0 then Hdr = result
            else Hdr = ''
            end
        otherwise nop
        end
    if Hdr > '' then do
        NowHeaders = NowHeaders + 1
        Header.Count = NowHeaders
        Header.NowHeaders = Hdr
        Changed = 1
        end
    return
;;;
/* ;;;Edit a header */
EditHeader:
    HdrType = upper(word(Header.HdrNo,1))
    Hdr = ''
    select
        when HdrType = 'CC:' then do
            Hdr = 'cc:'
            call GetAddress(subword(Header.HdrNo,2))
            end
        when HdrType = 'BCC:' then do
            Hdr = 'bcc:'
            call GetAddress(subword(Header.HdrNo,2))
            end
        when HdrType = 'FOLLOWUP-TO:' then do
            Hdr = 'Followup-To:'
            call GetConf(subword(Header.HdrNo,2))
            end
        when HdrType = 'REPLY-TO:' then do
            Hdr = 'Reply-To:'
            call GetAddress(subword(Header.HdrNo,2))
            end
        otherwise do
            REQUESTSTRING title '"Edit header"' body '"Editing 'Header.HdrNo'"' bt '" OK |Cancel"' id '"'Header.HdrNo'"'
            if RC = 0 then Hdr = result
            end
        end

    if Hdr ~= '' then do
        Header.HdrNo = Hdr
        Changed = 1
        end

    return
;;;
/* ;;;Delete a header */
DeleteHeader:
    do i = HdrNo to NowHeaders-1
        interpret 'Header.i = Header.'i+1
        end
    NowHeaders = NowHeaders - 1
    Changed = 1
    return
;;;
/* ;;;Ask for an email address */
GetAddress:
    parse arg default
    if default > '' then OldHdr = Hdr default                   /* Backup original header */
    else OldHdr = ''

    REQUESTSTRING title '"Address header"' body '"Enter email address(es)"' bt '" _OK |_Cancel"' id '"'default'"' maxchars 200
    if RC = 30 then ExitMsg(THOR.LASTERROR)
    if RC = 5 then do                                           /* If nothing entered */
        Hdr = OldHdr
        return
        end
    UserName = result
    UserAddr = ''
    drop USERS. SUG.
    address(bbsread)
    SEARCHBRUSER bbsname '"'System'"' stem USERS search '"'UserName'"' name address alias suggestusersstem SUG
    if RC = 30 then call ExitMsg(BBSREAD.LASTERROR)
    Found = result
    if Found > 0 then do                                        /* Match(es) found */
        drop LIST.
        drop USERTAGS.
        LIST.COUNT = USERS.COUNT

        do i = 1 to USERS.COUNT                                 /* Build a list of user names */
            LIST.i.USERNR = USERS.i.USERNR
            READBRUSER bbsname '"'System'"' usernr USERS.i.USERNR tagsstem USERTAGS
            if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
            LIST.i = USERTAGS.NAME
            if(symbol("USERTAGS.ADDRESS") = "VAR") then LIST.i.ADDRESS = USERTAGS.ADDRESS
            end

        address(thorport)                                       /* Select a user */
        drop UserName.
        REQUESTLIST instem LIST outstem USERS title '"Select user:"' dragselect
        if RC = 30 then call ExitMsg(THOR.LASTERROR)

        do j = 1 to USERS.COUNT
            do i = 1 to LIST.COUNT                              /* Check for email addresses */
                if LIST.i = USERS.j then UserAddr = UserAddr','LIST.i.ADDRESS
                end
            end

        end

    else do                                                     /* No exact match found */
        if(symbol("SUG.COUNT") = "VAR") then do
            address(thorport)
            drop USERS. UserNum.
            REQUESTLIST instem SUG outstem USERS title '"Select user:"' dragselect
            if RC = 30 then call ExitMsg(THOR.LASTERROR)
            if RC = 5 then do                                   /* If cancelled, use address as typed */
                Hdr = Hdr UserName
                return
                end
            do j = 1 to USERS.COUNT
                do i = 1 to SUG.COUNT                           /* Get the user number */
                    if SUG.i = USERS.j then UserNum.j = SUG.i.USERNR
                    end
                end

            address(bbsread)                                    /* Get data on users selected */
            do i = 1 to USERS.COUNT
                drop USERTAGS.
                READBRUSER bbsname '"'System'"' usernr UserNum.i tagsstem USERTAGS
                if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
                if(symbol("USERTAGS.ADDRESS") = "VAR") then UserAddr = UserAddr','USERTAGS.ADDRESS
                end
            end

        else do                                                 /* No users found in search */
            call ShowMsg('No matching users found')
            UserAddr = ''
            Hdr = OldHdr
            end
        end

if left(UserAddr,1) = ',' then UserAddr = substr(UserAddr,2)
if UserAddr > '' then Hdr = Hdr UserAddr
else Hdr = ''
return
;;;
/* ;;;Ask for a conference name */
GetConf:
    parse arg default
    if default > '' then OldHdr = Hdr default                      /* Backup original header */
    else OldHdr = ''

    address(bbsread)
    drop CONFS. SELECTED.
    GETCONFLIST bbsname '"'System'"' stem CONFS
    if RC = 30 then call ExitMsg(BBSREAD.LASTERROR)
    address(thorport)
    REQUESTLIST instem CONFS outstem SELECTED title '"Select newsgroup(s)"' dragselect
    select
        when RC = 30 then call ExitMsg(THOR.LASTERROR)
        when RC = 5 then Hdr = OldHdr
        otherwise do
            Conf = ''
            do i = 1 to SELECTED.COUNT
                if upper(SELECTED.i) = 'EMAIL' then SELECTED.i = 'poster'
                Conf = Conf','SELECTED.i
                end
            Hdr = Hdr substr(Conf,2)
            end
        end
    return
;;;